Comparison of Sentiment Tools across Domains

# load required libraries

# to use harry potter dataset
# devtools::install_github("bradleyboehmke/harrypotter")
# devtools::install_github("quanteda/quanteda.sentiment")
# devtools::install_github("quanteda/quanteda.corpora")

library(quanteda)
library(readtext)
library(corpus)
library(tidyverse)
library(stringr)
library(tidytext)
library(harrypotter)
library(dplyr)
library(quanteda.sentiment)
library(vader)
library(caret)
library(reshape2)


require(quanteda)
require(quanteda.corpora)
require(quanteda.sentiment)
#library("quanteda", warn.conflicts = FALSE, quietly = TRUE)

1. Step: Load Data & Lexicons

# load datasets
reviews <- readRDS(file="datasets/red_review.rds")
twitter <- readRDS(file="datasets/red_twitter.rds")
parlvote <- readRDS(file="datasets/red_parl_vote.rds")

# load lexicon
afinn <- data_dictionary_AFINN

reviews

twitter

parlvote

2. Step: Perform Sentiment Analysis

3. Step: Calculate Statistics

# convert to binary results
get_binary <- function(dataframes, type){
  for(df in dataframes){
    df$afinn_binary[df$afinn > 0] <- "pos"
    df$afinn_binary[df$afinn <= 0] <- "neg"
        
    df$lsd_binary[df$lsd > 0] <- "pos"
    df$lsd_binary[df$lsd <= 0] <- "neg"
        
    df$vader_binary[df$vader > 0] <- "pos"
    df$vader_binary[df$vader <= 0] <- "neg"
        
    df$rating_binary[df$rating >= 3] <- "pos"
    df$rating_binary[df$rating < 3] <- "neg"
    if(type == "01"){
      df[df == "pos"] <- 1
      df[df == "neg"] <- 0
    }
  }
  return(dataframes)
}


x <- get_binary(list(reviews_sentiment, twitter_sentiment, parlvote_sentiment), "01")

reviews_sentiment$afinn_binary[reviews_sentiment$afinn > 0] <- "1"
reviews_sentiment$afinn_binary[reviews_sentiment$afinn <= 0] <- "0"
reviews_sentiment$lsd_binary[reviews_sentiment$lsd > 0] <- "1"
reviews_sentiment$lsd_binary[reviews_sentiment$lsd <= 0] <- "0"
reviews_sentiment$vader_binary[reviews_sentiment$vader > 0] <- "1"
reviews_sentiment$vader_binary[reviews_sentiment$vader <= 0] <- "0"
reviews_sentiment$rating_binary[reviews_sentiment$rating >= 3] <- "1"
reviews_sentiment$rating_binary[reviews_sentiment$rating < 3] <- "0"

twitter_sentiment$afinn_binary[twitter_sentiment$afinn > 0] <- "1"
twitter_sentiment$afinn_binary[twitter_sentiment$afinn <= 0] <- "0"
twitter_sentiment$lsd_binary[twitter_sentiment$lsd > 0] <- "1"
twitter_sentiment$lsd_binary[twitter_sentiment$lsd <= 0] <- "0"
twitter_sentiment$vader_binary[twitter_sentiment$vader > 0] <- "1"
twitter_sentiment$vader_binary[twitter_sentiment$vader <= 0] <- "0"
twitter_sentiment$rating_binary[twitter_sentiment$rating == "Positive"] <- "1"
twitter_sentiment$rating_binary[twitter_sentiment$rating == "Negative"] <- "0"
twitter_sentiment$rating_binary[twitter_sentiment$rating == "Neutral"] <- NA

parlvote_sentiment$afinn_binary[parlvote_sentiment$afinn > 0] <- "1"
parlvote_sentiment$afinn_binary[parlvote_sentiment$afinn <= 0] <- "0"
parlvote_sentiment$lsd_binary[parlvote_sentiment$lsd > 0] <- "1"
parlvote_sentiment$lsd_binary[parlvote_sentiment$lsd <= 0] <- "0"
parlvote_sentiment$vader_binary[parlvote_sentiment$vader > 0] <- "1"
parlvote_sentiment$vader_binary[parlvote_sentiment$vader <= 0] <- "0"

# optionally: convert 0 = negative, 1 = positive
#reviews_50[reviews_50 == "pos"] <- 1
#reviews_50[reviews_50 == "neg"] <- 0

get_statistics <- function(df) {
  #statistics <- data.frame(matrix(ncol=4, nrow=0))
  #x <- c("accuracy", "precision", "recall", "F1")
  #colnames(statistics) <- x
  statistics <- data.frame(matrix(ncol=1, nrow=0))
  colnames(statistics) <- "accuracy"
  
  lex1 <- "afinn_binary"
  lex2 <- "lsd_binary"
  lex3 <- "vader_binary"
  gold <- "rating_binary"
  
  lexicons <- c(lex1,lex2,lex3)
  
  for(lex in lexicons){
    cf <- confusionMatrix(factor(df[[lex]]),factor(df[[gold]]))
    accuracy <- cf[[3]][1]
    #confusion_matrix <- table(ACTUAL=df[[gold]], PREDICTED=df[[lex]])
    #TN <- confusion_matrix[1]
    #FN <- confusion_matrix[2]
    #FP <- confusion_matrix[3]
    #TP <- confusion_matrix[4]
    
    # calculate statistics
    #precision <- TP/(TP+FP)
    #accuracy <- (TP+TN)/(TP+TN+FP+FN)
    #recall <- TP/(TP+FN)
    #F1 <- (2*precision*recall)/(precision+recall)
  
    # add to table
    #output <- c(accuracy,precision, recall, F1)
    #statistics[lex,] = rbind(statistics[[lex]], output)
    statistics[lex,] = rbind(statistics[[lex]], accuracy)
    #print(output)
    }
    
  return(statistics)
  
}

review_stats <- get_statistics(reviews_sentiment)
#twitter_stats <- get_statistics(twitter_sentiment)
#parlvote_stats <- get_statistics(parlvote_sentiment)

review_stats

4. Step: Plot Data

# plot columns
reviews_dfm <- melt(head(reviews_sentiment,50)[,c('id','afinn','lsd','vader')],id.vars = 1)

reviews_plot <- ggplot(reviews_dfm,aes(x = id,y = value)) + 
                geom_bar(aes(fill = variable),stat = "identity",position = "dodge") +
                ggtitle("Reviews Sentiments")


twitter_dfm <- melt(head(twitter_sentiment,50)[,c('id','afinn','lsd','vader')],id.vars = 1)

twitter_plot <- ggplot(twitter_dfm,aes(x = id,y = value)) + 
                geom_bar(aes(fill = variable),stat = "identity",position = "dodge") +
                ggtitle("Twitter Sentiments")

parlvote_dfm <- melt(head(parlvote_sentiment,50)[,c('id','afinn','lsd','vader')],id.vars = 1)

parlvote_plot <- ggplot(parlvote_dfm,aes(x = id,y = value)) + 
                geom_bar(aes(fill = variable),stat = "identity",position = "dodge")+
                facet_wrap(~ variable, ncol = 1, scales="free_y")+
                ggtitle("ParlVote Sentiments")

reviews_plot

twitter_plot

parlvote_plot

ADDITIONAL

Harry Potter - Dataset

# load harry potter dataset 
titles <- c("Philosopher's Stone", "Chamber of Secrets", "Prisoner of Azkaban",
            "Goblet of Fire", "Order of the Phoenix", "Half-Blood Prince",
            "Deathly Hallows")

books <- list(philosophers_stone, chamber_of_secrets, prisoner_of_azkaban,
           goblet_of_fire, order_of_the_phoenix, half_blood_prince,
           deathly_hallows)
  
series <- tibble()

for(i in seq_along(titles)) {
        
        clean <- tibble(chapter = seq_along(books[[i]]),
                        text = books[[i]]) %>%
             #unnest_tokens(word, text) %>%
             mutate(book = titles[i]) %>%
             select(book, everything())

        series <- rbind(series, clean)
}

series$book <- factor(series$book, levels = rev(titles))

series

#book_groups <- series %>% group_by(book, chapter)

Harry Potter - AFINN Lexicon

afinn_hp2 <- series %>%
        group_by(book, chapter) %>% # add word for single word scores 
        inner_join(get_sentiments("afinn")) %>%
        group_by(book, chapter) %>% # add word for single word scores
        #summarise(sentiment = sum(value)) %>%
        summarise(sentiment = mean(value, na.rm = TRUE)) %>%
        mutate(method = "AFINN")  %>%
        ggplot(aes(chapter, sentiment, fill = book)) +
          geom_bar(alpha = 0.8, stat = "identity", show.legend = FALSE) +
          facet_wrap(~ book, ncol = 2, scales = "free_x")

afinn_hp2

#ggsave(plot = afinn, width = 15, height = 15, dpi = 300, filename = "afinn_hp_mean.png")

Lexicoder: HP

hp1_lsd.df <- as.data.frame.matrix(hp1_lsd)

hp1_lsd.df$chapter <- 1:nrow(hp1_lsd.df)

plot <- ggplot(hp1_lsd, aes(x =hp1_lsd.df$chapter, y=sentiment)) +
          geom_bar(alpha = 0.8, stat = "identity", show.legend = FALSE)
plot + ylim(-1.0, 1.0) + labs(y="sentiment", x = "chapter") + ggtitle("HP1 - Lexicoder")

#hp1_lsd.df

AFINN: HP

plot + ylim(-1.0, 1.0) + labs(y="sentiment", x = "chapter") + ggtitle("HP1 - AFINN")

Warnung: Use of `hp1_afinn.df$chapter` is discouraged. Use `chapter` instead.

VADER: HP

QUANTEDA.SENTIMENT

AFINN: HP

# Work with quanteda.sentiment on HP corpus:

# convert tibble to dataframe
series.df <- as.data.frame(series)

# tokenize books
series_tokenized <- series.df %>%
  unnest_tokens(tokens, text)

# apply afinn lexicon
series_tokenized$afinn2 <- textstat_valence(series_tokenized$tokens, afinn2)$sentiment

# replace all 0 values with na
series_tokenized[series_tokenized == 0] <- NA

series_tokenized %>%
  group_by(book, chapter) %>% # group df by book and chapter to get sentiment per chapter
  summarise(sentiment = mean(afinn2, na.rm = TRUE)) %>% # calculate mean w/o regarding na values
  mutate(method = "AFINN") %>% # add column with method 
        ggplot(aes(chapter, sentiment, fill = book)) + # plot sentiment of books
          geom_bar(alpha = 0.8, stat = "identity", show.legend = FALSE) +
          facet_wrap(~ book, ncol = 2, scales = "free_x") +
          ggtitle("AFINN HP")

`summarise()` has grouped output by 'book'. You can override using the `.groups` argument.

Lexicoder: HP

# Work with quanteda.sentiment on HP corpus:

# apply lexicoder lexicon
series$lsd <- textstat_polarity(tokens(series$text), data_dictionary_LSD2015)$sentiment 

#series.df <- as.data.frame(series)

plot <- ggplot(series, aes(chapter, lsd, fill = book)) + # plot sentiment of books
          geom_bar(alpha = 0.8, stat = "identity", show.legend = FALSE) +
          facet_wrap(~ book, ncol = 2, scales = "free_x") +
          ggtitle("Lexicoder HP")
plot 

Vader: HP

REVIEWS DATASET

# load dataset
reviews <- readtext("datasets/goodreads_reviews_children_2.json", text_field = "review_text")

# convert to dataframe
reviews.df <- as.data.frame(reviews)

# add doc_id (i.e. according to index)
reviews.df$doc_id <- 1:nrow(reviews.df)

Sample Dataset

# get random sample of 50 reviews 
reviews_sample <- reviews.df[sample(1:nrow(reviews.df), 50,
   replace=FALSE),]

# get first 50 rows of data 
reviews_50 <- head(reviews.df,50)
reviews_50 = subset(reviews_50, select = c(doc_id,text,rating))
reviews_50

Get Translations of Dataset

# either via corpus 
reviews.corpus <- corpus(reviews)
docvars(reviews.corpus, "language") <- textcat(reviews.corpus)
reviews_en <- corpus_subset(reviews.corpus, language == "english", drop_docid = TRUE)

# or via dataframe logic
reviews.df$language <- textcat(reviews.df$text)

Sentiment Analysis on Reviews Dataset

AFINN

# Afinn
# tokenize 
reviews_tokenized <- reviews_50 %>%
  unnest_tokens(tokens, text)

# apply afinn lexicon
reviews_tokenized$afinn2 <- textstat_valence(reviews_tokenized$tokens, afinn2)$sentiment

# replace all 0 values with na
reviews_tokenized[reviews_tokenized == 0] <- NA

# calculate mean scores for tokens per doc
afinn_scores <- reviews_tokenized %>%
  group_by(doc_id) %>% # group df by doc_id to get mean sentiment score
  summarise(total = mean(afinn2, na.rm = TRUE)) #%>% # calculate mean w/o regarding na values

# add afinn scores to df 
reviews_50$afinn <- afinn_scores$total

# different version to get plot 
reviews_tokenized %>%
  group_by(doc_id) %>% # group df by book and chapter to get sentiment per chapter
  #reviews_tokenized$sentiment = mean(afinn2, na.rm = TRUE) %>%
  summarise(sentiment = mean(afinn2, na.rm = TRUE)) %>% # calculate mean w/o regarding na values
  mutate(method = "AFINN") %>% # add column with method 
        ggplot(aes(doc_id, sentiment, fill = doc_id)) + # plot sentiment of books
          geom_bar(alpha = 0.8, stat = "identity", show.legend = FALSE) +
          #facet_wrap(~ doc_id, ncol = 2, scales = "free_x") +
          ggtitle("AFINN Reviews")

Warnung: Removed 1 rows containing missing values (position_stack).

LEXICODER

# apply lexicoder lexicon
reviews_50$lsd <- textstat_polarity(tokens(reviews_50$text), data_dictionary_LSD2015)$sentiment 
#series.df <- as.data.frame(series)

plot <- ggplot(reviews_50, aes(doc_id, lsd, fill = doc_id)) + # plot sentiment of books
          geom_bar(alpha = 0.8, stat = "identity", show.legend = FALSE) +
          #facet_wrap(~ doc_id, ncol = 2, scales = "free_x") +
          ggtitle("Lexicoder Reviews")
plot 

Vader

Statistics

# convert to binary results
reviews_50$afinn_binary[reviews_50$afinn > 0] <- "pos"
reviews_50$afinn_binary[reviews_50$afinn <= 0] <- "neg"

reviews_50$lsd_binary[reviews_50$lsd > 0] <- "pos"
reviews_50$lsd_binary[reviews_50$lsd <= 0] <- "neg"

reviews_50$vader_binary[reviews_50$vader > 0] <- "pos"
reviews_50$vader_binary[reviews_50$vader <= 0] <- "neg"

reviews_50$rating_binary[reviews_50$rating >= 3] <- "pos"
reviews_50$rating_binary[reviews_50$rating < 3] <- "neg"

# optionally: convert 0 = negative, 1 = positive
reviews_50[reviews_50 == "pos"] <- 1
reviews_50[reviews_50 == "neg"] <- 0

actual_values <- twitter_sentiment$rating_binary
predict_values <- twitter_sentiment$afinn_binary

# create confusion matrix 
confusion_matrix <- table(ACTUAL=actual_values, PREDICTED=predict_values)

# assign values from matrix to true/false positives/negatives
TN <- confusion_matrix[1]
FN <- confusion_matrix[2]
FP <- confusion_matrix[3]
TP <- confusion_matrix[4]

# calculate statistics
precision <- TP/(TP+FP)
accuracy <- (TP+TN)/(TP+TN+FP+FN)
recall <- TP/(TP+FN)
F1 <- (2*precision*recall)/(precision+recall)

precision

[1] NA

accuracy

[1] NA

recall

[1] NA

confusion_matrix[3]

[1] NA

get_statistics <- function(df) {
  statistics <- data.frame(matrix(ncol=4, nrow=0))
  x <- c("accuracy", "precision", "recall", "F1")
  colnames(statistics) <- x
  lex1 <- "afinn_binary"
  lex2 <- "lsd_binary"
  lex3 <- "vader_binary"
  gold <- "rating_binary"
  
  lexicons <- c(lex1,lex2,lex3)
  
  for(lex in lexicons){
    confusion_matrix <- table(ACTUAL=df[[gold]], PREDICTED=df[[lex]])
    TN <- confusion_matrix[1]
    FN <- confusion_matrix[2]
    FP <- confusion_matrix[3]
    TP <- confusion_matrix[4]
  
    # calculate statistics
    precision <- TP/(TP+FP)
    accuracy <- (TP+TN)/(TP+TN+FP+FN)
    recall <- TP/(TP+FN)
    F1 <- (2*precision*recall)/(precision+recall)
  
    # add to table
    output <- c(accuracy,precision, recall, F1)
    statistics[lex,] = rbind(statistics[[lex]], output)
    }
    
  return(statistics)
  
}

get_statistics(test)